home *** CD-ROM | disk | FTP | other *** search
/ ftp.mactech.com 2010 / ftp.mactech.com.tar / ftp.mactech.com / thinkref / archive / THINKPascalUH2.1.sea / THINKPas Univ Hdr 2.1 / Interfaces / fp.p < prev    next >
Text File  |  1995-09-12  |  20KB  |  473 lines
  1. { Converted with MPW2TPas Tuesday, September 12, 1995 6:15:36 PM }
  2. {
  3.      File:        fp.p
  4.  
  5.      Copyright:    © 1994-1995 by Apple Computer, Inc.
  6.                  All rights reserved.
  7.  
  8.      Version:    Universal Pascal, March 29, 1995 
  9.     
  10.     Note:        The following file was hand converted from fp.h
  11.                 See fp.h for more information and comments.
  12. }
  13.  
  14.  
  15.  UNIT fp;
  16.  INTERFACE
  17.  
  18.  
  19. {$IFC UNDEFINED __FP__}
  20. {$SETC __FP__ := 1}
  21.  
  22.   USES
  23.    ConditionalMacros, Types;
  24.  
  25. CONST
  26.     DOUBLE_SIZE                    = 8;
  27.  
  28. {$IFC GENERATINGPOWERPC }
  29.     LONG_DOUBLE_SIZE            = 16;
  30.     DECIMAL_DIG                    = 17;  { does not exist for double-double }
  31. {$ELSEC}
  32.     DECIMAL_DIG                    = 21;
  33. {$IFC GENERATING68881}
  34.     LONG_DOUBLE_SIZE            = 12;
  35. {$ELSEC}
  36.     LONG_DOUBLE_SIZE            = 10;
  37. {$ENDC}
  38. {$ENDC}
  39.  
  40. {******************************************************************************
  41. *                            Trigonometric functions                           *
  42. ******************************************************************************}
  43.  
  44.  
  45. {FUNCTION cos(x: double_t): double_t; C;}
  46. {FUNCTION sin(x: double_t): double_t; C;}
  47. {FUNCTION tan(x: double_t): double_t; C;}
  48.  
  49. {FUNCTION acos(x: double_t): double_t; C;}    {  result is in [0,pi]          }
  50. {FUNCTION asin(x: double_t): double_t; C;}    {  result is in [-pi/2,pi/2]    }
  51. {FUNCTION atan(x: double_t): double_t; C;}    {  result is in [-pi/2,pi/2]    }
  52.  
  53. {    atan2 computes the arc tangent of y/x in [-pi,pi] using the sign of
  54.       both arguments to determine the quadrant of the computed value.         }
  55. {FUNCTION atan2(y: double_t; x: double_t): double_t; C;}
  56.  
  57.  
  58. {******************************************************************************
  59. *                              Hyperbolic functions                            *
  60. ******************************************************************************}
  61.  
  62. {FUNCTION cosh(x: double_t): double_t; C;}
  63. {FUNCTION sinh(x: double_t): double_t; C;}
  64. {FUNCTION tanh(x: double_t): double_t; C;}
  65. {FUNCTION acosh(x: double_t): double_t; C;}
  66. {FUNCTION asinh(x: double_t): double_t; C;}
  67. {FUNCTION atanh(x: double_t): double_t; C;}
  68.  
  69. {******************************************************************************
  70. *                              Exponential functions                           *
  71. ******************************************************************************}
  72.  
  73. {FUNCTION exp(x: double_t): double_t; C;}
  74.  
  75. {    expm1 computes the base e exponential of the argument minus 1,
  76.       i. e., exp(x) - 1.  For small enough arguments, expm1 is expected
  77.       to be more accurate than the straight forward computation of exp(x) - 1.}
  78. {FUNCTION expm1(x: double_t): double_t; C;}
  79.  
  80. {      exp2 computes the base 2 exponential.                                 }
  81. {FUNCTION exp2(x: double_t): double_t; C;}
  82. {FUNCTION frexp(x: double_t; VAR exponent: LONGINT): double_t; C;}
  83. {FUNCTION ldexp(x: double_t; n: LONGINT): double_t; C;}
  84. {FUNCTION log(x: double_t): double_t; C;}
  85.  
  86. {      log2 computes the base 2 logarithm.                                   }
  87. {FUNCTION log2(x: double_t): double_t; C;}
  88.  
  89. {    log1p computes the base e logorithm of 1 plus the argument,
  90.       i. e., log (1 x).  For small enough arguments, log1p is expected
  91.       to be more accurate than the straightforward computation of log (1+x).  }
  92. {FUNCTION log1p(x: double_t): double_t; C;}
  93. {FUNCTION log10(x: double_t): double_t; C;}
  94.  
  95. {    logb extracts the exponent of its argument, as a signed integral
  96.       value. A subnormal argument is treated as though it were first
  97.       normalized. Thus
  98.  
  99.       1 <= x  2^( - Logb ( x ) ) < 2                                         }
  100. {FUNCTION logb(x: double_t): double_t; C;}
  101. {FUNCTION modf(x: Double; VAR iptr: Double): Double; C;}
  102. {FUNCTION modff(x: Single; VAR iptrf: Single): Single; C;}
  103.  
  104. {    scalb computes x  2^n efficently.  This is not normally done by
  105.       computing 2^n explicitly.                                               }
  106. {FUNCTION scalb(x: double_t; n: LONGINT): double_t; C;}
  107.  
  108. {******************************************************************************
  109. *                     Power and absolute value functions                       *
  110. ******************************************************************************}
  111.  
  112. {FUNCTION fabs(x: double_t): double_t; C;}
  113.  
  114. {    hypot computes the square root of the sum of the squares of its
  115.       arguments, without undue overflow or underflow.                         }
  116. {FUNCTION hypot(x: double_t; y: double_t): double_t; C;}
  117. {FUNCTION pow(x: double_t; y: double_t): double_t; C;}
  118. {FUNCTION sqrt(x: double_t): double_t; C;}
  119.  
  120. {******************************************************************************
  121. *                        Gamma and Error functions                             *
  122. ******************************************************************************}
  123.  
  124. {FUNCTION erf(x: double_t): double_t; C;}
  125. {FUNCTION erfc(x: double_t): double_t; C;}    {   complementary error function   }
  126.  
  127. {FUNCTION gamma(x: double_t): double_t; C;}
  128.  
  129. {    lgamma computes the base-e logarithm of the absolute value of
  130.       gamma of its argument x, for x > 0.                                     }
  131. {FUNCTION lgamma(x: double_t): double_t; C;}
  132.  
  133. {******************************************************************************
  134. *                        Nearest integer functions                             *
  135. ******************************************************************************}
  136.  
  137. {FUNCTION ceil(x: double_t): double_t; C;}
  138. {FUNCTION floor(x: double_t): double_t; C;}
  139.  
  140. {    the rint function rounds its argument to an integral value in floating
  141.       point format, honoring the current rounding direction.                  }
  142. {FUNCTION rint(x: double_t): double_t; C;}
  143.  
  144. {    nearbyint differs from rint only in that it does not raise the
  145.       inexact exception. It is the nearbyint function recommended by the
  146.       IEEE floating-point standard 854.                                       }
  147. {FUNCTION nearbyint(x: double_t): double_t; C;}
  148.  
  149. {    the function rinttol rounds its argument to the nearest long using
  150.       the current rounding direction.
  151.       >>Note that if the rounded value is outside the range of long, then
  152.       the result is undefined.                                                }
  153. {FUNCTION rinttol(x: double_t): LONGINT; C;}
  154.  
  155. {    the round function rounds the argument to the nearest integral value
  156.       in double format similar to the Fortran "anint" function.  That is:
  157.       add half to the magnitude and chop.                                     }
  158. {FUNCTION round(x: double_t): double_t; C;}
  159.  
  160. {    roundtol is similar to the Fortran function nint or to the Pascal round
  161.       >>Note that if the rounded value is outside the range of long, then
  162.       the result is undefined.                                                }
  163. {FUNCTION roundtol(round: double_t): LONGINT; C;}
  164.  
  165. {    trunc computes the integral value, in floating format, nearest to
  166.       but no larger in magnitude than its argument.                           }
  167. {FUNCTION trunc(x: double_t): double_t; C;}
  168.  
  169. {******************************************************************************
  170. *                            Remainder functions                               *
  171. ******************************************************************************}
  172.  
  173. {FUNCTION fmod(x: double_t; y: double_t): double_t; C;}
  174.  
  175. {    the following two functions compute the remainder.  remainder is required
  176.       by the IEEE 754 floating point standard. The second form correponds to the
  177.       SANE remainder; it stores into 'quotient' the 7 low-order bits of the
  178.       integer quotient x/y, such that -127 <= quotient <= 127.                }
  179. {FUNCTION remainder(x: double_t; y: double_t): double_t; C;}
  180. {FUNCTION remquo(x: double_t; y: double_t; VAR quo: LONGINT): double_t; C;}
  181.  
  182.  
  183. {******************************************************************************
  184. *                             Auxiliary functions                              *
  185. ******************************************************************************}
  186.  
  187. {FUNCTION copysign(x: double_t; y: double_t): double_t; C;}
  188. {FUNCTION nan(tagp: ConstCStringPtr): Double; C;}
  189. {FUNCTION nanf(tagp: ConstCStringPtr): Single; C;}
  190.  
  191. {FUNCTION nextafterd(x: Double; y: Double): Double; C;}
  192. {FUNCTION nextafterf(x: Single; y: Single): Single; C;}
  193.  
  194. {******************************************************************************
  195. *                      Max, Min and Positive Difference                        *
  196. ******************************************************************************}
  197.  
  198. {     These extension functions correspond to the standard functions, dim
  199.       max and min.
  200.  
  201.       The fdim function determines the 'positive difference' between its
  202.       arguments: ( x - y, if x > y ), ( +0, if x <= y ).  If one argument is
  203.       NaN, then fdim returns that NaN.  if both arguments are NaNs, then fdim
  204.       returns the first argument.                                             }
  205. {FUNCTION fdim(x: double_t; y: double_t): double_t; C;}
  206.  
  207. {    max and min return the maximum and minimum of their two arguments,
  208.       respectively.  They correspond to the max and min functions in FORTRAN.
  209.       NaN arguments are treated as missing data.  If one argument is NaN and
  210.       the other is a number, then the number is returned.  If both are NaNs
  211.       then the first argument is returned.                                    }
  212. {FUNCTION fmax(x: double_t; y: double_t): double_t; C;}
  213. {FUNCTION fmin(x: double_t; y: double_t): double_t; C;}
  214.  
  215. {******************************************************************************
  216. *                              Inquiry functions                               *
  217. ******************************************************************************}
  218.  
  219. CONST
  220.     FP_SNAN     = 0;        {      signaling NaN                         }
  221.     FP_QNAN     = 1;        {      quiet NaN                             }
  222.     FP_INFINITE = 2;        {      + or - infinity                       }
  223.     FP_ZERO        = 3;        {      + or - zero                           }
  224.     FP_NORMAL    = 4;        {      all normal numbers                    }
  225.     FP_SUBNORMA = 5;        {      denormal numbers                      }
  226.  
  227.  
  228. {FUNCTION __fpclassifyd(x: Double): LONGINT; C;}
  229. {FUNCTION __fpclassifyf(x: Single): LONGINT; C;}
  230.  
  231. {FUNCTION __isnormald(x: Double) : LONGINT; C;}
  232. {FUNCTION __isnormalf(x: Single): LONGINT; C;}
  233.  
  234. {FUNCTION __isfinited(x: Double): LONGINT; C;}
  235. {FUNCTION __isfinitef(x: Single): LONGINT; C;}
  236.  
  237. {FUNCTION __isnand(x: Double): LONGINT; C;}
  238. {FUNCTION __isnanf(x: Single): LONGINT; C;}
  239.  
  240. {FUNCTION __signbitd(x: Double): LONGINT; C;}
  241. {FUNCTION __signbitf(x: Single): LONGINT; C;}
  242.  
  243. FUNCTION __inf: Double;
  244.  
  245.  
  246. {******************************************************************************
  247. *                              Non NCEG extensions                             *
  248. ******************************************************************************}
  249.  
  250.  
  251. {$IFC UNDEFINED __NOEXTENSIONS__ }
  252.  
  253. {******************************************************************************
  254. *                              Financial functions                             *
  255. ******************************************************************************}
  256.  
  257. {     compound computes the compound interest factor "(1 + rate) ^ periods"
  258.       more accurately than the straightforward computation with the Power
  259.       function.  This is SANE's compound function.                            }
  260. {FUNCTION compound(rate: double_t; periods: double_t): double_t; C;}
  261.  
  262. {    The function annuity computes the present value factor for an annuity 
  263.       "( 1 - ( 1 + rate ) ^ ( - periods ) ) / rate" more accurately than the
  264.       straightforward computation with the Power function. This is SANE's 
  265.       annuity function.                                                       }
  266. {FUNCTION annuity(rate: double_t; periods: double_t): double_t; C;}
  267.  
  268. {******************************************************************************
  269. *                              Random function                                 *
  270. ******************************************************************************}
  271.  
  272. {FUNCTION randomx(VAR x: double_t): double_t; C;}
  273.  
  274.  
  275. {******************************************************************************
  276. *                              Relational operator                             *
  277. ******************************************************************************}
  278.  
  279. TYPE
  280.     relop = INTEGER;        {      relational operator      }
  281.  
  282. CONST
  283.     GREATERTHAN                    = 0;
  284.     LESSTHAN                    = 1;
  285.     EQUALTO                        = 2;
  286.     UNORDERED                    = 3;
  287.  
  288.  
  289. {FUNCTION relation(x: double_t; y: double_t): relop; C;}
  290.  
  291.  
  292.  
  293. {******************************************************************************
  294. *                         Binary to decimal conversions                        *
  295. ******************************************************************************}
  296.  
  297. CONST
  298. {$IFC GENERATINGPOWERPC }
  299.     SIGDIGLEN                    = 36;                    { significant decimal digits }
  300. {$ELSEC}
  301.     SIGDIGLEN                    = 20;                    { significant decimal digits }
  302. {$ENDC}
  303.     DECSTROUTLEN                = 80;                    { max length for dec2str output }
  304.  
  305. TYPE
  306.     DecimalKind = (FloatDecimal,FixedDecimal);
  307.  
  308. {     The decimal record type provides an intermediate unpacked form for
  309.       programmers who wish to do their own parsing of numeric input or
  310.       formatting of numeric output.                                         }
  311.     
  312.     {$ALIGN MAC68K}
  313.     Decimal = RECORD
  314.         sgn:     0..1;            { sign 0 for +, 1 for -  }
  315.         exp:     INTEGER;
  316.         sig:     STRING[SIGDIGLEN];
  317.     END;
  318.     {$ALIGN RESET}
  319.  
  320. {    Each conversion to a decimal string is controlled by a decform
  321.       structure.  The style is either FLOATDECIMAL or FIXEDDECIMAL defined
  322.       above.  The value of digits is the number of significant digits for
  323.       FLOATDECIMAL.  The value of digits for FIXEDDECIMAL is the number of
  324.       digits to the right of the decimal point.                               }
  325.       
  326.     {$ALIGN MAC68K}
  327.     Decform = RECORD
  328.         style:     DecimalKind;
  329.         digits: INTEGER;
  330.     END;
  331.     {$ALIGN RESET}
  332.     
  333. {    Each conversion to a decimal record d via the function call num2dec is 
  334.       controlled by a decform record f (defined earlier), to a double_t x.    }
  335. {PROCEDURE num2dec((*CONST* )VAR f: Decform; x: double_t; VAR d: decimal); C;}
  336.  
  337.  
  338. { dec2num converts a decimal record d to a double_t value.          }
  339. {FUNCTION dec2num((*CONST* )VAR d: Decimal): double_t; C;}
  340.  
  341. {    The MathLib formatter dec2str is controlled by a decform f.  Input d is
  342.       a decimal record.                                                       }
  343. {PROCEDURE dec2str((*CONST* )VAR f: Decform; (*CONST* )VAR d: Decimal; s: CStringPtr); C;}
  344.  
  345. {    The function str2dec is the MathLib scanner.                            }
  346. {PROCEDURE str2dec(s: ConstCStringPtr; VAR ix: INTEGER; VAR d: Decimal; VAR vp: INTEGER); C;}
  347.  
  348. {$IFC GENERATING68K }
  349. {    dec2d is similar to dec2num except a double is returned on 68k platforms }
  350. {FUNCTION dec2d((*CONST* )VAR d: Decimal): Double; C;}
  351. {$ENDC}
  352.  
  353. {    dec2f is similar to dec2num except a float is returned.                 }
  354. {FUNCTION dec2f((*CONST* )VAR d: Decimal): Single; C;}
  355.  
  356. {    dec2s is similar to dec2num except a short is returned.                 }
  357. {FUNCTION dec2s((*CONST* )VAR d: Decimal): INTEGER; C;}
  358.  
  359. {    dec2l is similar to dec2num except a long is returned.                  }
  360. {FUNCTION dec2l((*CONST* )VAR d: Decimal): LONGINT; C;}
  361.  
  362. {******************************************************************************
  363. *                    68k-only Transfer Function Prototypes                     *
  364. ******************************************************************************}
  365.  
  366. {$IFC GENERATING68K }
  367.  
  368. {PROCEDURE x96tox80((*CONST* )VAR x96: extended96; VAR x80: extended80); C;}
  369. {PROCEDURE x80tox96((*CONST* )VAR x80: extended80; VAR x96: extended96); C;}
  370.  
  371. {$ENDC}     { GENERATING68K }
  372.  
  373.  
  374. {$ENDC} {__NOEXTENSIONS__}
  375.  
  376. {******************************************************************************
  377. *                         PowerPC-only Function Prototypes                     *
  378. ******************************************************************************}
  379.  
  380. {$IFC GENERATINGPOWERPC }
  381. {FUNCTION cosl(x: LongDouble): LongDouble; C;}
  382. {FUNCTION sinl(x: LongDouble): LongDouble; C;}
  383. {FUNCTION tanl(x: LongDouble): LongDouble; C;}
  384.  
  385. {FUNCTION acosl(x: LongDouble): LongDouble; C;}
  386. {FUNCTION asinl(x: LongDouble): LongDouble; C;}
  387. {FUNCTION atanl(x: LongDouble): LongDouble; C;}
  388. {FUNCTION atan2l(y: LongDouble; x: LongDouble): LongDouble; C;}
  389.  
  390. {FUNCTION coshl(x: LongDouble): LongDouble; C;}
  391. {FUNCTION sinhl(x: LongDouble): LongDouble; C;}
  392. {FUNCTION tanhl(x: LongDouble): LongDouble; C;}
  393.  
  394. {FUNCTION acoshl(x: LongDouble): LongDouble; C;}
  395. {FUNCTION asinhl(x: LongDouble): LongDouble; C;}
  396. {FUNCTION atanhl(x: LongDouble): LongDouble; C;}
  397.  
  398. {FUNCTION expl(x: LongDouble): LongDouble; C;}
  399. {FUNCTION expm1l(x: LongDouble): LongDouble; C;}
  400. {FUNCTION exp2l(x: LongDouble): LongDouble; C;}
  401.  
  402. {FUNCTION frexpl(x: LongDouble; VAR exponent: LONGINT): LongDouble; C;}
  403. {FUNCTION ldexpl(x: LongDouble; n: LONGINT): LongDouble; C;}
  404.  
  405. {FUNCTION logl(x: LongDouble): LongDouble; C;}
  406. {FUNCTION log1pl(x: LongDouble): LongDouble; C;}
  407. {FUNCTION log10l(x: LongDouble): LongDouble; C;}
  408. {FUNCTION log2l(x: LongDouble): LongDouble; C;}
  409.  
  410. {FUNCTION logbl(x: LongDouble): LongDouble; C;}
  411. {FUNCTION scalbl(x: LongDouble; n: LONGINT): LongDouble; C;}
  412.  
  413. {FUNCTION fabsl(x: LongDouble): LongDouble; C;}
  414. {FUNCTION hypotl(x: LongDouble; y: LongDouble): LongDouble; C;}
  415. {FUNCTION powl(x: LongDouble; y: LongDouble): LongDouble; C;}
  416. {FUNCTION sqrtl(x: LongDouble): LongDouble; C;}
  417.  
  418. {FUNCTION erfl(x: LongDouble): LongDouble; C;}
  419. {FUNCTION erfcl(x: LongDouble): LongDouble; C;}
  420. {FUNCTION gammal(x: LongDouble): LongDouble; C;}
  421. {FUNCTION lgammal(x: LongDouble): LongDouble; C;}
  422.  
  423. {FUNCTION ceill(x: LongDouble): LongDouble; C;}
  424. {FUNCTION floorl(x: LongDouble): LongDouble; C;}
  425. {FUNCTION rintl(x: LongDouble): LongDouble; C;}
  426. {FUNCTION nearbyintl(x: LongDouble): LongDouble; C;}
  427. {FUNCTION rinttoll(x: LongDouble): LONGINT; C;}
  428. {FUNCTION roundl(x: LongDouble): LongDouble; C;}
  429. {FUNCTION roundtoll(round: LongDouble): LONGINT; C;}
  430. {FUNCTION truncl(x: LongDouble): LongDouble; C;}
  431. {FUNCTION remainderl(x: LongDouble; y: LongDouble): LongDouble; C;}
  432. {FUNCTION remquol(x: LongDouble; y: LongDouble; VAR quo: LONGINT): LongDouble; C;}
  433. {FUNCTION copysignl(x: LongDouble; y: LongDouble): LongDouble; C;}
  434. {FUNCTION fdiml(x: LongDouble; y: LongDouble): LongDouble; C;}
  435. {FUNCTION fmaxl(x: LongDouble; y: LongDouble): LongDouble; C;}
  436. {FUNCTION fminl(x: LongDouble; y: LongDouble): LongDouble; C;}
  437.  
  438. {FUNCTION modfl(x: LongDouble; VAR iptrl: LongDouble): LongDouble; C;}
  439. {FUNCTION nanl(tagp: ConstCStringPtr): LongDouble; C;}
  440. {FUNCTION nextafterl(x: LongDouble; y: LongDouble): LongDouble; C;}
  441. {FUNCTION __fpclassify(x: LongDouble): LONGINT; C;}
  442. {FUNCTION __isnormal(x: LongDouble): LONGINT; C;}
  443. {FUNCTION __isfinite(x: LongDouble): LONGINT; C;}
  444. {FUNCTION __isnan(x: LongDouble): LONGINT; C;}
  445. {FUNCTION __signbit(x: LongDouble): LONGINT; C;}
  446.  
  447. {$IFC UNDEFINED __NOEXTENSIONS__ }
  448. {FUNCTION relationl(x: LongDouble; y: LongDouble): relop; C;}
  449. {PROCEDURE x80told(x80: extended80; VAR x: LongDouble); C;}
  450. {PROCEDURE ldtox80(x: LongDouble; VAR x80: extended80); C;}
  451.  
  452. {    MathLib v2 has two new transfer functions: x80tod and dtox80.  They can 
  453.       be used to directly transform 68k 80-bit extended data types to double
  454.       and back for PowerPC based machines without using the functions
  455.       x80told or ldtox80.  Double rounding may occur.                         
  456. }
  457. {FUNCTION x80tod((*CONST* )VAR x80: extended80): Double; C;}
  458. {PROCEDURE dtox80((*CONST* )VAR x: Double; VAR x80: extended80); C;}
  459.  
  460. {PROCEDURE num2decl((*CONST* )VAR f: Decform; x: LongDouble; VAR d: Decimal); C;}
  461. {FUNCTION dec2numl((*CONST* )VAR d: Decimal): LongDouble; C;}
  462. {$ENDC} { __NOEXTENSIONS__ }
  463.  
  464. {$ENDC} { GENERATINGPOWERPC }
  465.  
  466.  
  467.  
  468. {$ENDC} {__FP__}
  469.  
  470.  IMPLEMENTATION
  471.  END.
  472.  
  473.